home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / comp0_89.lha / Feel / Boot / CBoot / standard0.old < prev    next >
Lisp/Scheme  |  1993-05-01  |  2KB  |  66 lines
  1. ;; Eulisp Module
  2. ;; Author: pab
  3. ;; File: standard0.em
  4. ;; Date: Thu Dec 17 16:03:19 1992
  5. ;;
  6. ;; Project:
  7. ;; Description: 
  8. ;;  All Of Eulisp. This is the compiled version....
  9.  
  10. (defmodule standard0
  11.   ((rename ((car real-car) (cdr real-cdr) (vector-ref real-vector-ref))
  12.        standard)
  13.    (rename ((car internal-car) (cdr internal-cdr)) lists)
  14.    (rename ((vector-ref internal-vector-ref)) vectors)
  15.    semaphores
  16.    )
  17.   ()
  18.   (expose (except (scan-args fold) standard))
  19.   (expose semaphores)
  20.   (export slot-description-initargs slot-value
  21.       class-direct-slot-descriptions
  22.       allocate-instance 
  23.       make-instance initialize-instance
  24.       generic-function-method-class
  25.       slot-value-using-slot-description
  26.       class-direct-slot-descriptions)
  27.  
  28.   (defconstant make-instance make)
  29.   (defconstant allocate-instance allocate)
  30.   (defconstant initialize-instance initialize)
  31.   (defconstant generic-function-method-class generic-method-class)
  32.   
  33.   (defun slot-description-initargs (x)
  34.     (if (slot-description-initarg x)
  35.     (list (slot-description-initarg x))
  36.       nil))
  37.   
  38.   (defun slot-value (obj name)
  39.     ((slot-description-slot-reader (find-slot-description (class-of obj) name)) obj))
  40.  
  41.   ((setter setter) slot-value
  42.    (lambda (obj name value)
  43.      ((slot-description-slot-writer (find-slot-description (class-of obj) name)) obj value)))
  44.  
  45.   (defun slot-value-using-slot-description (o s)
  46.     ((slot-description-slot-reader s) o))
  47.  
  48.   ((setter setter) slot-value-using-slot-description 
  49.    (lambda (o s v)
  50.      ((slot-description-slot-writer s) o v)))
  51.  
  52.   (defconstant class-direct-slot-descriptions class-slot-descriptions)
  53.   
  54.   (defconstant *safety* (if (equal (getenv "FEEL_SAFETY") "None") nil t))
  55.  
  56.   (defconstant car (if *safety* internal-car real-car))
  57.   (defconstant cdr (if *safety* internal-cdr real-cdr))
  58.   (defconstant vector-ref (if *safety* internal-vector-ref real-vector-ref))
  59.   (export car cdr vector-ref)
  60.   (defconstant pair <pair>)
  61.  
  62.   (export pair)
  63.  
  64. ;; end module
  65.   )
  66.